Software 2000/Software 2000 Volume 1 (Disc 1 of 2).iso/utilities/u288.dms/in.adf/Examples/DeadKeysPlus.p

Text File | 1991-04-05 | 6.0 KB | 251 lines

Program DeadKeysPlus;

{
    This program is the same as an older program called DeadKeys,
which used the DeadKeyConvert() and RawKeyConvert() functions to
get keystrokes in a very compatible way.  To that I have added
mostly useless menus, which are an example of the use of the
BuildMenu routines.  These, in turn, exercise the Intuition menu
functions.
    To make a long story short, if you are looking for an example
of DeadKeyConvert() or BuildMenu it's in here somewhere.

    Although you would certainly want the code to be more modular
and you would need to design a data structure, this is the barest
bones of a text editor.
}

{$I "Include:Exec/Interrupts.i"}
{$I "Include:Exec/Libraries.i"}
{$I "Include:Exec/Ports.i"}
{$I "Include:Exec/IO.i"}
{$I "Include:Exec/Devices.i"}
{$I "Include:Utils/IOUtils.i"}
{$I "Include:Intuition/Intuition.i"}
{$I "Include:Devices/InputEvent.i"}
{$I "Include:Utils/ConsoleUtils.i"}
{$I "Include:Utils/ConsoleIO.i"}
{$I "Include:Utils/DeadKeyConvert.i"}
{$I "Include:Utils/BuildMenu.i"}

var
    w  : WindowPtr;
    s  : Address;

Function OpenTheScreen : Boolean;
var
    ns : NewScreenPtr;
begin
    new(ns);
    with ns^ do begin
    LeftEdge := 0;
    TopEdge  := 0;
    Width    := 640;
    Height   := 200;
    Depth    := 2;
    DetailPen := 3;
    BlockPen  := 2;
    ViewModes := 32768;
    SType     := CUSTOMSCREEN_f;
    Font      := Nil;
    DefaultTitle := "Press ESC or choose Quit to End the Demonstration";
    Gadgets   := nil;
    CustomBitMap := nil;
    end;
    s := OpenScreen(ns);
    dispose(ns);
    OpenTheScreen := s <> nil;
end;

Function OpenTheWindow : Boolean;
var
    nw : NewWindowPtr;
begin
    new(nw);
    with nw^ do begin
    LeftEdge := 0;
    TopEdge := 2;
    Width := 640;
    Height := 198;

    DetailPen := -1;
    BlockPen  := -1;
    IDCMPFlags := RAWKEY_f + MENUPICK_f;
    Flags := SMART_REFRESH + ACTIVATE +
            BORDERLESS + BACKDROP;
    FirstGadget := Nil;
    CheckMark := Nil;
    Title := "";
    Screen := s;
    BitMap := Nil;
    MinWidth := 0;
    MaxWidth := -1;
    MinHeight := 0;
    MaxHeight := -1;
    WType := CUSTOMSCREEN_f;
    end;

    w := OpenWindow(nw);
    dispose(nw);
    OpenTheWindow := w <> nil;
end;

var
    IMessage    : IntuiMessagePtr;
    Buffer    : Array [0..9] of Char;
    Length    : Integer;
    Leave    : Boolean;
    WriteReq    : IOStdReqPtr;
    WritePort    : MsgPortPtr;

Function AddTheMenus : Boolean;
begin
    InitializeMenu(w);
    NewMenu("Project");
    NewItem("New ",'N');
    NewItem("Load",'L');
    NewItem("Save",'S');
    NewItem("Quit",'Q');
    NewMenu("Action");
    NewItem("Defoliate      ",'D');
    NewItem("Repack Bearings",'R');
    NewItem("Mince        >>",'\0');
    NewSubItem("Slice   ", '1');
    NewSubItem("Dice    ", '2');
    NewSubItem("Julienne", '3');
    NewItem("Floss          ",'F');
    AttachMenu;
    AddTheMenus := True;
end;

Procedure LoseTheMenus;
begin
    DetachMenu;
end;

Procedure OpenEverything;
var
    Error : Short;
begin
    OpenConsoleDevice;
    if OpenTheScreen then begin
    if OpenTheWindow then begin
        if AddTheMenus then begin
        WritePort := CreatePort(Nil, 0);
        if WritePort <> Nil then begin
            WriteReq := CreateStdIO(WritePort);
            if WriteReq <> Nil then begin
            WriteReq^.io_Data := Address(w);
            WriteReq^.io_Length := SizeOf(Window);
            Error := OpenDevice("console.device", 0,
                        IORequestPtr(WriteReq), 0);
            if Error = 0 then
                return;
            DeleteStdIO(WriteReq);
            Writeln('Could not open the console.device');
            end else
            Writeln('Could not allocate memory');
            DeletePort(WritePort);
        end else
            Writeln('Could not allocate a message port');
        LoseTheMenus;
        end else
        Writeln('Could not attach the menus');
        CloseWindow(w);
    end else
        Writeln('Could not open the window');
    CloseScreen(s);
    end else
    Writeln('Could not open the screen');
    CloseConsoleDevice;
    Exit(20);
end;

Procedure CloseEverything;
begin
    CloseDevice(IORequestPtr(WriteReq));
    DeleteStdIO(WriteReq);
    DeletePort(WritePort);
    LoseTheMenus;
    CloseWindow(w);
    CloseScreen(s);
    CloseConsoleDevice;
end;

Procedure ConvertControl;
begin
    case Ord(Buffer[0]) of
      8 : ConPutStr(WriteReq, "\b\cP");
     13 : ConPutStr(WriteReq, "\n\cL");
     127 : ConPutStr(WriteReq, "\cP");
    else
    ConPutChar(WriteReq, Buffer[0]);
    end;
end;

Procedure ConvertTwoChar;
begin
    case Buffer[1] of
      'A'..'D' : ConWrite(WriteReq, Adr(Buffer), 2);
    end;
end;

begin
    OpenEverything;
    Leave := False;
    repeat
    IMessage := IntuiMessagePtr(WaitPort(w^.UserPort));
    IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
    if IMessage^.Class = RAWKEY_f then begin
        if IMessage^.Code < 128 then begin { Key Down }
        Length := DeadKeyConvert(IMessage, Adr(Buffer), 10, Nil);
        case Length of
          -MaxInt..-1 : ConWrite(WriteReq, "DeadKeyConvert error",20);
           1 : if Buffer[0] = '\e' then
               Leave := True
            else begin
                if (Buffer[0] < ' ') or
                (Ord(Buffer[0]) > 126) then
                ConvertControl
                else begin
                Buffer[2] := Buffer[0];
                Buffer[0] := '\c';
                Buffer[1] := '@'; { Insert }
                ConWrite(WriteReq, Adr(Buffer), 3);
                end;
            end;
           2 : ConvertTwoChar;
        end;
        end;
    end else if IMessage^.Class = MENUPICK_f then begin
        if IMessage^.Code = MENUNULL then
        ConWrite(WriteReq, "\nNo item", 8)
        else begin
        Buffer[0] := Chr(MenuNum(IMessage^.Code) + Ord('0'));
        Buffer[1] := '\n';
        ConWrite(WriteReq, "\nMenu Number: ", 14);
        ConWrite(WriteReq, Adr(Buffer), 2);
        Buffer[0] := Chr(ItemNum(IMessage^.Code) + Ord('0'));
        ConWrite(WriteReq, "Item Number: ", 13);
        ConWrite(WriteReq, Adr(Buffer), 2);
        if SubNum(IMessage^.Code) <> NOSUB then begin
            Buffer[0] := Chr(SubNum(IMessage^.Code) + Ord('0'));
            ConWrite(WriteReq, "Sub Number : ", 13);
            ConWrite(WriteReq, Adr(Buffer), 2);
        end;
        if (MenuNum(IMessage^.Code) = 0) and
            (ItemNum(IMessage^.Code) = 3) then
            Leave := True;
        end;
    end else { Must be CloseWindow }
        Leave := True;
    ReplyMsg(MessagePtr(IMessage));
    until Leave;
    Forbid;
    repeat
    IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
    until IMessage = nil;
    Permit;
    CloseEverything;
end.